Attribute VB_Name = "modGlobal"
Option Explicit
'==================================================================================
'Copyright (c) 2003, Andrew Jeremy Gargan (ajg@osite.co.za), Terence Leslie Van Zyl (tvz@osite.co.za)
'
'All rights reserved.
'
'Redistribution and use in source and binary forms, with or without modification,
'are permitted provided that the following conditions are met:
'
'Redistributions of source code must retain the above copyright notice, this list
'of conditions and the following disclaimer.
'
'Redistributions in binary form must reproduce the above copyright notice, this
'list of conditions and the following disclaimer in the documentation and/or other
'materials provided with the distribution.
'
'Neither the name of the <ORGANIZATION> nor the names of its contributors may be
'used to endorse or promote products derived from this software without specific
'prior written permission.
'
'THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
'ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
'WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
'IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
'INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
'BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
'DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
'LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
'OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
'OF THE POSSIBILITY OF SUCH DAMAGE.
'===================================================================================

Public Type MailRecip
    Address As String
    Name As String
    Type As Integer
End Type

Public Type MailAttach
    Name As String
    filename As String
End Type
    
Public Type Mail
    ID As String
    RecipCount As Integer
    Recips() As MailRecip
    AttachCount As Integer
    Attach() As MailAttach
    Subject As String
    Text As String
    From As MailRecip
    DateReceived As Date
    Unread As Boolean
End Type

Public Type user
    Name As String
    Email As Integer
    Data As MailRecip
    Image As Integer
    Report As MailAttach
    Address1 As String
    Address2 As String
    Address4 As String
    Pcode As String
End Type

'Database connection
Public gvarDatabase As DAO.Database

'Config Options
Public gvarConfig As clsConfig
Public gvarPhotoPath As String
Public gvarDamagePath As String

'Constants for path Type
Public Const pthBranch = 0
Public Const pthStatements = 1
Public Const pthStatistics = 2
Public Const pthReports = 3
Public Const pthPhotos = 4
Public Const pthAuthorisations = 5

Public Function get_assessment_path(ByVal anASS_KEY As Long, Optional ByVal aType As Long = 0) As String
    Dim lvarRS As DAO.Recordset
    Dim lvarQuery As String
    Dim lvarTemp As String
    Dim lvarFSO As FileSystemObject
   
    lvarQuery = "SELECT " & _
                "ASS_DATE_ASSESSED,ASS_INVOICE_NO,ASS_PAID," & _
                "INSURANCE.INS_KEY,INSURANCE.INS_NAME," & _
                "BRANCH.BRA_KEY,BRANCH.BRA_NAME," & _
                "CLARK.CLR_KEY,CLARK.CLR_NAME," & _
                "ASSESOR.ASO_KEY,ASSESOR.ASO_NAME " & _
                "FROM " & _
                "((((ASSESSMENT " & _
                "INNER JOIN BRANCH ON BRANCH.BRA_KEY = ASSESSMENT.BRA_KEY)" & _
                "INNER JOIN CLARK ON CLARK.CLR_KEY = ASSESSMENT.CLR_KEY)" & _
                "INNER JOIN ASSESOR ON ASSESOR.ASO_KEY = ASSESSMENT.ASO_KEY)" & _
                "INNER JOIN INSURANCE ON INSURANCE.INS_KEY = ASSESSMENT.INS_KEY)" & _
                "WHERE ASS_KEY=" & anASS_KEY
    
    Set lvarRS = gvarDatabase.OpenRecordset(lvarQuery, dbOpenForwardOnly)
    
    'get data directory
    lvarTemp = gvarConfig.DataPath
    If Not lvarTemp Like "*\" Then 'remember the slashes
        lvarTemp = lvarTemp & "\"
    End If
    
    'Always we want the branch location
    lvarTemp = lvarTemp & lvarRS("BRA_NAME") & "\"
    
    Select Case (aType)
        Case pthBranch: 'it is good as it is
        Case pthStatements:
            lvarTemp = lvarTemp & "STATEMENTS\"
        Case pthStatistics:
            lvarTemp = lvarTemp & "STATISTICS\"
        Case pthReports:
            lvarTemp = lvarTemp & "REPORTS\"
        Case pthPhotos:
            lvarTemp = lvarTemp & "PHOTOS\"
        Case pthAuthorisations:
            lvarTemp = lvarTemp & "AUTHORISATIONS\"
    End Select
    
    Set lvarFSO = New FileSystemObject
    
    get_assessment_path = lvarTemp
End Function

Public Function unique_file(aPath As String) As String
    Dim lvarSplitStr() As String
    Dim lvarCounter As Long
    
    Dim lvarPosDot As Long
    Dim lvarPosNameEnd As Long
    Dim lvarPosUnd As Long
    
    Dim lvarTemp As String
    Dim lvarPath As String
    
    Dim lvarFolderPath As String
    Dim lvarFileName As String
    Dim lvarFileNameFull As String
    Dim lvarExtention As String
    
    Dim lvarFSO As FileSystemObject
    
    Set lvarFSO = New FileSystemObject
    
    If lvarFSO.FileExists(aPath) Then
        lvarSplitStr = Split(aPath, "\")
        
        'build a path and test it
        'build path excluding file name
        lvarFolderPath = lvarSplitStr(0)
        For lvarCounter = 1 To UBound(lvarSplitStr) - 1
            lvarPath = lvarPath & lvarSplitStr(lvarCounter) & "\"
        Next
        
        'break up filename
        lvarFileNameFull = lvarSplitStr(UBound(lvarSplitStr))
        lvarPosDot = InStrRev(lvarFileNameFull, ".")
        lvarExtention = IIf(lvarPosDot > 0, Mid(lvarFileNameFull, lvarPosDot), "")
        'try to find _NUM.
        '
        If (lvarPosDot > 0) Then
            lvarPosNameEnd = lvarPosDot - 1
        Else
            lvarPosNameEnd = Len(lvarFileNameFull) - 1
        End If
        
        'Check for increments
        lvarFileName = Mid(lvarFileNameFull, 0, lvarPosNameEnd + 1)
        lvarPosUnd = InStrRev(lvarFileName, "_")
        lvarTemp = IIf(lvarPosUnd > 0 And lvarPosUnd < lvarPosDot - 2, Mid(lvarPosUnd, 0, lvarPosUnd), "")
        
        If lvarTemp <> "" Then
            lvarTemp = Mid(lvarTemp, 1) 'hack the _
            'Check if it was an increment
            If IsNumeric(lvarTemp) Then 'Increment
                lvarFileName = Mid(lvarFileName, 0, lvarPosUnd) & "_" & 1 + Val(lvarTemp)
            Else 'first duplicate with _ in name
                lvarFileName = lvarFileName & "_2"
            End If
        Else 'first duplicate
            lvarFileName = lvarFileName & "_2"
        End If
        
        lvarPath = lvarFolderPath & lvarFileName & lvarExtention
        
        'recursive call
        lvarPath = unique_file(lvarTemp)
    Else
        lvarPath = aPath
    End If
    
    unique_file = lvarPath
End Function

Public Function file_photos(ByVal anASS_KEY As Long, Optional ByVal overwrite As Boolean = False)
    Dim lvarTextBox As TextBox
    Dim lvarPictureBox As PictureBox
    Dim lvarCounter As Long
    Dim lvarPosExt As Long
    Dim lvarFSO As FileSystemObject
    Dim lvarPathBase As String
    Dim lvarPathBaseInt As String
    Dim lvarPath As String
    Dim lvarRS As DAO.Recordset
    Dim lvarSQL As String
    Dim lvartmp1 As String
    Dim lvartmp2 As String
    
    Dim lvarTemp As String
    Dim lvarExtension As String
    
    On Error GoTo errorhandler
    Set lvarFSO = New FileSystemObject
    If anASS_KEY < 1 Then
        'don't really wanna throw my own error
        GoTo errorhandler
        Exit Function
    Else
        lvarSQL = "SELECT COUNT(ASS_KEY) AS ASS_KEY_COUNT FROM ASSESSMENT WHERE ASS_KEY=" & anASS_KEY
        lvarCounter = gvarDatabase.OpenRecordset(lvarSQL, dbOpenForwardOnly)("ASS_KEY_COUNT")
        If lvarCounter = 1 Then
            lvarSQL = "SELECT * FROM ASSESSMENT WHERE ASS_KEY=" & anASS_KEY
            Set lvarRS = gvarDatabase.OpenRecordset(lvarSQL, dbOpenForwardOnly)
        Else
            'don't really wanna throw my own error
            GoTo errorhandler
            Exit Function
        End If
    
        'get photo path
        'External Filing
        lvarPathBase = get_assessment_path(anASS_KEY, pthPhotos)
        Check_Dir lvarPathBase
        lvarPathBase = Trim(lvarPathBase) & Trim(IIf(lvarRS("ASS_RE_ASSESSMENT"), "RE-", ""))
        lvarPathBase = lvarPathBase & Trim(Str(lvarRS("ASS_INVOICE_NO")) & "_")
        
        'Internal Filing
        lvarPathBaseInt = gvarPhotoPath '& Trim(Str(anASS_KEY)) & "_"
        
        'loop through and file
        For lvarCounter = 1 To 12
            
            'This should jump us out if we  dn't have in table
            On Error GoTo outofloop
            lvarTemp = IIf(IsNull(lvarRS("ASS_PHOTO_" & lvarCounter)), "", lvarRS("ASS_PHOTO_" & lvarCounter))
            On Error GoTo errorhandler
            
            If lvarTemp <> "" Or lvarTemp <> "blank.jpg" Then
                
                If lvarFSO.FileExists(lvarPathBaseInt & lvarTemp) Then
                    
                    lvarPosExt = InStrRev(lvarTemp, ".")
                    If lvarPosExt = 0 Then
                        lvarExtension = ""
                    Else
                        lvarExtension = Mid(lvarTemp, lvarPosExt)
                    End If
                    
                    lvarPath = lvarPathBase & lvarCounter & lvarExtension
                    
                
                    'if it doesn't exist or is set to overwrite
                    If Not lvarFSO.FileExists(lvarPath) Or overwrite = True Then
                        VBA.FileCopy lvarPathBaseInt & lvarRS("ASS_PHOTO_" & lvarCounter), lvarPath
                    End If
                
                End If
                
            End If
        Next
outofloop:
        file_photos = True
        End If
    Exit Function
errorhandler:
    file_photos = False
    On Error GoTo 0
End Function

Public Function MailSend(ByRef ThisMail As Mail) As Integer
    Dim AttachCount As Long
    Dim RecipCount As Long
' returns  0: OK, -1: No recipients, -2: Not logged on, >0 : can't resolve recipient x
  On Error GoTo err
  MailSend = 0
  'If ThisMail.RecipCount = 0 Then
  '   MailSend = -1
  '   Debug.Print "MailSend: ERROR: No Recipients"
  '   Exit Function
  'End If
  frmMain.mvarMAPIMessages.Compose
  frmMain.mvarMAPIMessages.MsgNoteText = ThisMail.Text
  frmMain.mvarMAPIMessages.MsgSubject = ThisMail.Subject
'  For RecipCount = 1 To ThisMail.RecipCount
'      frmMain.mvarMAPIMessages.RecipIndex = RecipCount - 1
'      frmMain.mvarMAPIMessages.RecipDisplayName = ThisMail.Recips(RecipCount).Name
'      frmMain.mvarMAPIMessages.RecipAddress = ThisMail.Recips(RecipCount).Address
'      frmMain.mvarMAPIMessages.ResolveName
'      frmMain.mvarMAPIMessages.RecipType = ThisMail.Recips(RecipCount).Type
'  Next
 ' Debug.Print "MailSend: Added Recipients"
  
  If ThisMail.AttachCount <> 0 Then
     frmMain.mvarMAPIMessages.MsgNoteText = frmMain.mvarMAPIMessages.MsgNoteText + String(ThisMail.AttachCount + 2, " ")
     For AttachCount = 1 To ThisMail.AttachCount
         frmMain.mvarMAPIMessages.AttachmentIndex = AttachCount - 1
         frmMain.mvarMAPIMessages.AttachmentName = ThisMail.Attach(AttachCount - 1).Name
         frmMain.mvarMAPIMessages.AttachmentPathName = ThisMail.Attach(AttachCount - 1).filename
         frmMain.mvarMAPIMessages.AttachmentPosition = CLng(Len(ThisMail.Text) + AttachCount)
     Next
     'Debug.Print "MailSend: Added Attachments"
  Else
     'Debug.Print "MailSend: No Attachments"
  End If
  ThisMail.ID = frmMain.mvarMAPIMessages.MsgID
  'frmMain.mvarMAPIMessages.Name = frmMain.mvarMAPIMessages.MsgOrigDisplayName
  
  ThisMail.From.Address = frmMain.mvarMAPIMessages.MsgOrigAddress
  ThisMail.From.Type = 0
  'frmMain.mvarMAPIMessages.Send
  
  'Debug.Print "MailSend: Mail Sent"
  Exit Function
err:
  Select Case err
       Case 32014, 32001
           'can't resolve name
            MailSend = RecipCount
       Case 32011           'can't find attachment
            MailSend = 1000 + AttachCount
       Case 32053
            MailSend = -2
       Case 380
            MailSend = -3
       Case Else
            MsgBox err.Description, vbExclamation, "Error " & err
  End Select
End Function

Public Sub send_mail(aSubject As String, aMessage As String, Optional anAddress As String = "", Optional aFile As String = "")
    Dim lvarFSO As New FileSystemObject
    Dim myMail As Mail
    Dim myAttach As MailAttach
    Dim myRecip As MailRecip
    Dim lvarSplit() As String
    err.Clear
    
    frmMain.mvarMAPISession.NewSession = True
    frmMain.mvarMAPISession.LogonUI = True
    'frmMain.mvarMAPISession.Password = ""
    'frmMain.mvarMAPISession.UserName = "Andrew Gargan"
    
    frmMain.mvarMAPISession.SignOn
    
    If err.Number = 32050 Then
        err.Clear
    ElseIf err.Number <> 0 Then
        Select Case MsgBox(err.Number & " " & err.Description, vbAbortRetryIgnore)
        Case vbIgnore
            err.Clear
        Case vbAbort
        '    Call Unload(Me)
        Case vbRetry
            Exit Sub
        End Select
    End If
    
    frmMain.mvarMAPIMessages.SessionID = frmMain.mvarMAPISession.SessionID
    frmMain.mvarMAPIMessages.MsgIndex = -1
    'If Err.Number <> 0 Then
    '    Select Case MsgBox(Err.Number & " " & Err.Description, vbAbortRetryIgnore)
    '    Case vbIgnore
    '        Err.Clear
    '    Case vbAbort
    '        Call Unload(Me)
    '    Case vbRetry
    '        Exit Sub
    '    End Select
    'End If
    'frmMain.mvarMAPIMessages.Compose
    
    
    If anAddress <> "" Then
        myRecip.Address = anAddress
        myMail.Recips(0) = myRecip
        'mvarMAPIMessages.RecipAddress = anAddress
    End If
    'mvarMAPIMessages.RecipType = 1
    
    myMail.Subject = aSubject
    myMail.Text = aMessage
    'mvarMAPIMessages.MsgSubject = aSubject
    'mvarMAPIMessages.MsgNoteText = aMessage
    
    If aFile <> "" Then
        myMail.AttachCount = 1
        ReDim Preserve myMail.Attach(0)
        myAttach.filename = aFile
        lvarSplit() = Split(aFile, "\")
        myAttach.Name = lvarSplit(UBound(lvarSplit))
        myMail.Attach(0) = myAttach
    End If
    
    'frmMain.mvarMAPIMessages.AttachmentIndex = 0
    'frmMain.mvarMAPIMessages.AttachmentCount = 1
    'frmMain.mvarMAPIMessages.AttachmentName = "REPORT"
    'frmMain.mvarMAPIMessages.AttachmentPosition CLng(Len(ThisMail.Text) + AttachCount)
    MailSend myMail
    frmMain.mvarMAPIMessages.Send True
    'frmMain.mvarMAPIMessages.Compose
    'If Err.Number <> 0 Then
    '    Select Case MsgBox(Err.Number & " " & Err.Description, vbAbortRetryIgnore)
    '    Case vbIgnore
    '        Err.Clear
    '    Case vbAbort
    '        Call Unload(Me)
    '    Case vbRetry
    '        Exit Sub
    '    End Select
    'End If
    frmMain.mvarMAPISession.SignOff
End Sub

Public Function Check_Dir(aPath As String, Optional aCreate As Boolean = True, Optional aVerbose As Boolean = False) As Boolean
    Dim lvarPath As String
    Dim lvarCounter As Long
    Dim lvarSplitStr() As String
    Dim lvarFSO As New FileSystemObject
    
    On Error GoTo errorhandler
    lvarSplitStr = Split(aPath, ":")
    If lvarFSO.DriveExists(lvarSplitStr(0)) Then
        lvarPath = lvarSplitStr(0) & ":"
        lvarSplitStr = Split(aPath, "\")
        lvarCounter = 1
        While lvarCounter < UBound(lvarSplitStr) 'check sub dirs
            lvarPath = lvarPath & "\" & lvarSplitStr(lvarCounter)
            If Not lvarFSO.FolderExists(lvarPath) Then 'create sub folder if it doesn't exist
                If aCreate Then
                    If aVerbose Then
                        MsgBox "Creating " & lvarPath, vbOKOnly, "Data Directory"
                    End If
                    lvarFSO.CreateFolder (lvarPath)
                Else
                    Check_Dir = False
                End If
            End If
            lvarCounter = lvarCounter + 1
        Wend
    Else
        'Drive Not Mapped
        Check_Dir = False
    End If
    Check_Dir = True
    Exit Function
errorhandler:
    Check_Dir = False
    On Error GoTo 0
End Function

Public Function file_monthly(aFile As String, aFilePath As String) As Boolean
    Dim lvarFSO As FileSystemObject
    Dim lvarAutoFilePath As String
    Dim lvarTemp As String
    
    On Error Resume Next
    
    'get folder in which it should be filed
    'lvarAutoFilePath = get_assessment_path(mvarASS_KEY, aType)
    
    'make sure folder exists/create it
    'If Not Check_Dir(lvarAutoFilePath, True) Then
    '   file_pdf = False
    '    On Error GoTo 0
    '    Exit Function
    'End If
    
    'If aFilename = "" Then
    '    Select Case (aType)
    '        Case pthAuthorisations:
    '            lvarTemp = IIf(mvarRE_ASSESSMENT, "RE-", "") & txtASS_INVOICE_NO & "_auth.pdf"
    '        Case pthReports:
    '            lvarTemp = IIf(mvarRE_ASSESSMENT, "RE-", "") & txtASS_INVOICE_NO & "_report.pdf"
    '        'TODO: Figure out how to build these paths
    '        'Case pthStatistics:
    '        '    lvarTemp = IIf(mvarRE_ASSESSMENT, "RE-", "") & txtASS_INVOICE_NO & "_auth.pdf"
    '        'Case pthStatements:
    '        '    lvarTemp = IIf(mvarRE_ASSESSMENT, "RE-", "") & txtASS_INVOICE_NO & "_auth.pdf"
    '    End Select'
    '
    '    'get the files name
    '    lvarAutoFilePath = lvarAutoFilePath & lvarTemp
    'Else
    '    lvarAutoFilePath = lvarAutoFilePath & aFilename
    'End If
    'make it a unique filename
    'lvarAutoFilePath = unique_file(lvarAutoFilePath)

    'copy the file
    VBA.FileCopy aFile, aFilePath

    file_monthly = True
    On Error GoTo 0
    Exit Function
errorhandler:
    file_monthly = False
    On Error GoTo 0
End Function

Private Sub create_dirs()
    Dim lvarRS As DAO.Recordset
    Dim lvarSQL As String
    Dim lvarBasePath As String
    Dim lvarPath As String
    
    lvarSQL = "SELECT * FROM BRANCH"
    Set lvarRS = gvarDatabase.OpenRecordset(lvarSQL, dbOpenForwardOnly)
    
    Do While Not lvarRS.EOF
        'go through all Branches and make sure they have the directories
        lvarBasePath = gvarConfig.DataPath & Trim(lvarRS("BRA_NAME")) & "\"
        Check_Dir lvarBasePath
        
        lvarPath = lvarBasePath & "PHOTOS\"
        Check_Dir lvarPath
        
        lvarPath = lvarBasePath & "REPORTS\"
        Check_Dir lvarPath
        
        lvarPath = lvarBasePath & "AUTHORISATIONS\"
        Check_Dir lvarPath
        
        lvarPath = lvarBasePath & "STATEMENTS\"
        Check_Dir lvarPath
        
        lvarPath = lvarBasePath & "STATISTICS\"
        Check_Dir lvarPath
        
        lvarRS.MoveNext
    Loop
End Sub

Private Sub Main()
    Dim lvarPath As String
    On Error GoTo errorhandler
    
    'DATABASE CONNECTION
    lvarPath = VB.App.Path & "\assessment.mdb"
    
    gvarPhotoPath = VB.App.Path & "\photos\"
    If Not Check_Dir(gvarPhotoPath, True) Then
        MsgBox "Error With Photo path : " & gvarPhotoPath
        End
    End If
    
    gvarDamagePath = VB.App.Path & "\damage\"
    If Not Check_Dir(gvarDamagePath, True) Then
        MsgBox "Error With Damage Picture Path : " & gvarDamagePath
        End
    End If
    
    'lvarPath = "C:\Program Files\Motor Accident Assessment\assessment.mdb"
    Set gvarDatabase = DAO.OpenDatabase(lvarPath)
    
    'Configuration Settings from DB
    Set gvarConfig = New clsConfig
    gvarConfig.Get_Config
    
    'Time trial expirey
    Dim lvarKey As String
    lvarKey = VBA.GetSetting("Assessment", "Register", "Key", "")
    If VBA.Date > CDate("01-Apr-2006") And lvarKey <> "MonkeyNut" Then
        lvarKey = InputBox("Trial time expired, Please enter key", "Program Registration")
        If lvarKey = "MonkeyNut" Then
            VBA.SaveSetting "Assessment", "Register", "Key", "MonkeyNut"
        Else
            End
        End If
    End If
    
    'If MsgBox("Run Fix?", vbYesNo, "Fix data") = vbYes Then
    '    fix_data
    'End If
    frmMain.Show
    
    Exit Sub
errorhandler:
    MsgBox VBA.Error
    On Error GoTo 0
End Sub
